home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 3: CDPD 3 / Almathera Ten on Ten - Disc 3: CDPD3.iso / scope / 051-075 / scopedisk53 / klondike20 / klondike < prev    next >
Text File  |  1995-03-18  |  16KB  |  600 lines
  1.   CLEAR,32000&
  2.   DEFINT a-z
  3.   WINDOW 1,,(417,11)-(617,59),31,-1
  4.  
  5.   at&=0:text&=0:printat&=0:shadow&=0:sxy&=0:scolr&=0:sbox&=0:dbox&=0
  6.   drawmode&=0:title&=0:loadfont&=0:usefont&=0:killfont&=0:style&=0
  7.   refresh&=0:iffload&=0:iffsave&=0:loadRGB&=0:saveRGB&=0:request&=0
  8.   checkfile&=0:bload&=0:bsave&=0:bopenr&=0:bopenw&=0:bread&=0:bwrite&=0
  9.   seek&=0:bclose&=0:getmem&=0:freemem&=0:zero&=0:copy&=0:w7&=0:bye&=0
  10.  
  11.   filesize&=0:blowup&=0
  12.   nl$=CHR$(0):DIM rgb(32,1):win$="***  YOU WIN !!!  ***"+nl$
  13.  
  14.   DIM hidden(8,5),down(8),showing(8,12),up(8),deck(51),p(12),f(4),out(4)
  15.   DIM card(566,4),tx$(13),timbre(255),colr(2),talon(23),fback(3152)
  16.  
  17.   DIM ml(99)
  18.   OPEN "ml_loader" FOR INPUT AS #1
  19.      FOR i=0 TO 99:ml(i)=CVI(INPUT$(2,1)):NEXT
  20.   CLOSE #1
  21.   ml&=VARPTR(ml(0)):ml& SADD("jlib"+nl$),VARPTR(at&),WINDOW(7)
  22.   ERASE ml
  23.  
  24.   WINDOW CLOSE 1
  25.   SCREEN 1,640,200,3,2
  26.   WINDOW 2,,,0,1
  27.   w7& WINDOW(7):sxy& 2,1
  28.   POKE WINDOW(7)+99,0:refresh&
  29.   FOR i=1 TO 4:MENU i,0,0,"":NEXT
  30.  
  31.   bopenr& SADD("kdata"+nl$)
  32.   bread& VARPTR(rgb(0,0)),64
  33.   loadRGB& VARPTR(rgb(0,0)),32
  34.  
  35.   FOR a=0 TO 98 STEP 2:LINE (2*a,a)-(631-2*a,195-a),1,b:NEXT
  36.   FOR a=98 TO 50 STEP -1:LINE (2*a,a)-(631-2*a,195-a),2,b:NEXT
  37.   FOR a=35 TO 98 STEP 2:LINE (a+70,2*a+1)-(561-a,194-2*a),1,b:NEXT
  38.   FOR a=98 TO 35 STEP -1:LINE (a+70,2*a+1)-(561-a,194-2*a),2,b:NEXT
  39.   scolr& 1,7
  40.   shadow& -1,68,SADD("******  KLONDIKE  ******"+nl$)
  41.   shadow& -1,108,SADD("Revisions, additions and enhancements"+nl$)
  42.   shadow& -1,118,SADD("in AmigaBASIC by john everett"+nl$)
  43.   scolr& 1,3
  44.   shadow& -1,83,SADD("Original ABasic version"+nl$)
  45.   shadow& -1,93,SADD("by David Addison"+nl$)
  46.  
  47.   bread& VARPTR(timbre(0)),512:WAVE 0,timbre:WAVE 1,timbre
  48.   bread& VARPTR(timbre(0)),512:WAVE 2,timbre:WAVE 3,timbre
  49.   getmem& VARPTR(blowup&),200,65537&
  50.   bread& blowup&,200
  51.   bclose&
  52.   CHDIR "cards"
  53.   skipflag=-1:GOSUB amideck:skipflag=0
  54.  
  55.   money=0:c$="A23456789TJQK"
  56.   FOR i=1 TO 13:READ tx$(i):NEXT
  57.   DATA "N ACE"," TWO"," THREE"," FOUR"," FIVE"," SIX"," SEVEN"
  58.   DATA "N EIGHT"," NINE"," TEN"," JACK"," QUEEN"," KING"
  59.  
  60.   checkfile& SADD("blowup"+nl$),VARPTR(filesize&)
  61.   IF filesize&>0 THEN
  62.     blowup&=0
  63.     getmem& VARPTR(blowup&),filesize&,65537&
  64.     bload& SADD("blowup"+nl$),blowup&,filesize&
  65.   END IF
  66.  
  67. start:
  68.   CLS:ding
  69.   zero& VARPTR(talon(0)),24
  70.   zero& VARPTR(f(0)),5
  71.   zero& VARPTR(out(0)),5
  72.   zero& VARPTR(hidden(0,0)),54
  73.   zero& VARPTR(showing(0,0)),117
  74.   card=0
  75.   FOR i=1 TO 4
  76.     FOR j=1 TO 13
  77.       deck(card)=100*i+j
  78.       card=card+1
  79.     NEXT
  80.   NEXT
  81.   FOR j=1 TO 3
  82.     RANDOMIZE TIMER
  83.     FOR i=51 TO 0 STEP -1
  84.       x=INT(RND*i)+1
  85.       SWAP deck(x),deck(i)
  86.     NEXT
  87.   NEXT
  88.   card=0
  89.   money=money-52
  90.   FOR i=1 TO 6
  91.     FOR j=0 TO i-1
  92.       hidden(i+2,j)=deck(card)
  93.       card=card+1
  94.     NEXT
  95.   NEXT
  96.   FOR i=0 TO 6
  97.     showing(i+2,0)=deck(card)
  98.     down(i+2)=i
  99.     card=card+1
  100.   NEXT
  101.   FOR i=2 TO 8:up(i)=1:NEXT
  102.   up(0)=0
  103.   LINE (11,136)-STEP(59,12),1,bf
  104.   LINE (13,137)-STEP(55,10),0,bf
  105.   LINE (15,138)-STEP(51,8),1,bf
  106.   GOSUB prtmoney
  107.   PUT (10,150),card(0,0),PSET
  108.   SOUND 70,.25,255,2
  109.   FOR i=10 TO 151 STEP 47:LINE (79,i)-STEP(59,44),1,b:NEXT
  110.   FOR i=1 TO 7
  111.     xx=69*i+79
  112.     yy=8*i+1
  113.     GOSUB dealcard
  114.     num=showing(i+1,0)
  115.     GOSUB whichcard
  116.     playcard xx,yy
  117.     FOR j=i+1 TO 7
  118.       xx=69*j+79
  119.       GOSUB dealcard
  120.       PUT (xx,yy),card(0,0),PSET
  121.       SOUND 70,.25,255,2
  122.     NEXT
  123.   NEXT
  124.   sbox& 150,184,7,SADD("MENU"+nl$)
  125.   GOSUB flipcard
  126.   column=0:holding=0:fdation=0
  127. checkmouse:
  128.   WHILE MOUSE(0)<>0:WEND
  129.   IF holding THEN GOSUB playit ELSE WHILE MOUSE(0)=0:SLEEP:WEND
  130.   xpos=MOUSE(3):ypos=MOUSE(4)
  131.   IF ypos>184 AND xpos>150 AND xpos<190 THEN fastmenu
  132.   column=INT((xpos-6)/69)
  133.   IF column>-1 AND column<>1 AND column<9 THEN
  134.     IF holding THEN
  135.       GOSUB 410
  136.     ELSEIF column=0 AND ypos>149 THEN
  137.       GOSUB flipcard
  138.     ELSE
  139.       GOSUB pickupcard
  140.     END IF
  141.   END IF
  142.   GOTO checkmouse
  143.  
  144. whichcard:
  145.   suit=INT(num/100)
  146.   value=num-100*suit
  147.   RETURN
  148.  
  149. flipcard:
  150.   IF holding THEN CALL oops(1):RETURN
  151.   IF card>51 THEN CALL oops(2):RETURN
  152.   talon(up(0))=deck(card)
  153.   card=card+1
  154.   IF card>51 THEN
  155.     FOR i=194 TO 150 STEP -4
  156.       LINE (10,i)-STEP(61,3),0,bf
  157.     NEXT
  158.   END IF
  159.   num=talon(up(0))
  160.   GOSUB whichcard
  161.   playcard 10,4*up(0)+9
  162.   up(0)=up(0)+1
  163.   RETURN
  164.  
  165. playit:
  166.   drawmode& 2
  167.   LINE (xpos-30,ypos)-STEP(61,44),,b
  168.   x=xpos:y=ypos
  169.   WHILE MOUSE(0)=0
  170.     xpos=MOUSE(1):ypos=MOUSE(2)
  171.     IF xpos<>x OR ypos<>y THEN
  172.       LINE (x-30,y)-STEP(61,44),,b
  173.       LINE (xpos-30,ypos)-STEP(61,44),,b
  174.       x=xpos:y=ypos
  175.     END IF
  176.   WEND
  177.   LINE (x-30,y)-STEP(61,44),,b
  178.   drawmode& 0
  179.   RETURN
  180.  
  181. 410 :
  182.   IF NOT holding THEN CALL oops(3):RETURN
  183.   IF column=0 THEN
  184.     IF fromcolumn<>0 THEN CALL oops(7):RETURN
  185.     num=talon(up(0)-1)
  186.     GOSUB whichcard
  187.     playcard 69*column+10,4*(up(0))+5
  188.     holding=0
  189.     RETURN
  190.   END IF
  191.   IF fromcolumn=column THEN
  192.     FOR i=0 TO up(column)-1
  193.       num=showing(column,i)
  194.       GOSUB whichcard
  195.       playcard 69*column+10,8*(i+down(column))+9
  196.     NEXT
  197.     holding=0
  198.     RETURN
  199.   END IF
  200.   IF up(column)=0 THEN
  201.     IF fromcolumn=0 THEN num=talon(up(0)-1) ELSE num=showing(fromcolumn,0)
  202.     GOSUB whichcard
  203.     IF value<>13 THEN CALL oops(8):RETURN
  204.   ELSE
  205.     num=showing(column,up(column)-1)
  206.     GOSUB whichcard
  207.     tempsuit=suit
  208.     tempvalue=value
  209.     IF fromcolumn=0 THEN num=talon(up(0)-1) ELSE num=showing(fromcolumn,0)
  210.     GOSUB whichcard
  211.     IF tempsuit<3 AND suit<3 THEN CALL oops(4):RETURN
  212.     IF tempsuit>2 AND suit>2 THEN CALL oops(5):RETURN
  213.     IF tempvalue<>value+1 THEN CALL oops(6):RETURN
  214.   END IF
  215.   IF fromcolumn=0 THEN
  216.     showing(column,up(column))=num
  217.     up(column)=up(column)+1
  218.     playcard 69*column+10,8*(up(column)+down(column))+1
  219.     up(0)=up(0)-1
  220.     talon(up(0))=0
  221.     holding=0
  222.     RETURN
  223.   END IF
  224.   FOR i=0 TO up(fromcolumn)-1
  225.     num=showing(fromcolumn,i)
  226.     showing(column,up(column))=num
  227.     GOSUB whichcard
  228.     up(column)=up(column)+1
  229.     playcard 69*column+10,8*(up(column)+down(column))+1
  230.     showing(fromcolumn,i)=0
  231.   NEXT
  232.   up(fromcolumn)=0
  233.   holding=0
  234.   IF hidden(fromcolumn,0)=0 THEN RETURN
  235.   num=hidden(fromcolumn,0)
  236.   GOSUB whichcard
  237.   playcard 69*fromcolumn+10,8*down(fromcolumn)+1
  238.   showing(fromcolumn,up(fromcolumn))=num
  239.   up(fromcolumn)=1
  240.   FOR i=0 TO 4
  241.     hidden(fromcolumn,i)=hidden(fromcolumn,i+1)
  242.   NEXT
  243.   hidden(fromcolumn,5)=0
  244.   down(fromcolumn)=down(fromcolumn)-1
  245.   IF down(fromcolumn)<0 THEN down(fromcolumn)=0
  246.   RETURN
  247.  
  248. pickupcard:
  249.   IF up(column)=0 THEN CALL oops(9):RETURN
  250.   IF column=0 THEN
  251.     temp=4*up(0)+9
  252.   ELSE
  253.     temp=8*(up(column)+down(column))+7
  254.   END IF
  255.   IF ypos>temp AND ypos<temp+44 THEN
  256.     GOSUB 930
  257.     IF fdation THEN
  258.       FOR i=1 TO 4
  259.         IF out(i)<13 THEN fdation=0
  260.       NEXT
  261.       IF fdation=0 THEN RETURN
  262.       FOR i=0 TO 31
  263.         COLOR i AND 7
  264.         printat& 200+i,3*i,SADD(win$)
  265.         printat& 200+i,192-3*i,SADD(win$)
  266.         printat& 462-i,3*i,SADD(win$)
  267.         printat& 462-i,192-3*i,SADD(win$)
  268.       NEXT
  269.       FOR temp=0 TO 6
  270.         COLOR 7-temp:SOUND 200*temp+500,20,255,0:SOUND 250*temp+625,20,255,1
  271.         printat& 200+i,3*i,SADD(win$):printat& 462-i,3*i,SADD(win$)
  272.         pause 1!
  273.       NEXT
  274.       GOTO fastmenu
  275.     END IF
  276.   END IF
  277.   fromcolumn=column
  278.   holding=-1
  279.   erasecard column,down(column)+up(column),down(column)
  280.   IF column=0 THEN
  281.     num=talon(up(0)-1)
  282.     IF up(0)-1>0 THEN
  283.       num=talon(up(0)-2)
  284.       GOSUB whichcard
  285.       playcard 10,4*(up(0))+1
  286.     END IF
  287.     RETURN
  288.   END IF
  289. putback:
  290.   IF hidden(column,0)>0 THEN
  291.     PUT (69*column+10,8*down(column)+1),card(0,0),PSET
  292.     FOR i=3 TO 0 STEP -1
  293.       SOUND (i+1)*1000,1,255,0
  294.       SOUND (i+1)*1000,1,255,1
  295.     NEXT
  296.   END IF
  297.   RETURN
  298.  
  299. 930 :
  300.   IF column=0 THEN num=talon(up(0)-1) ELSE num=showing(column,up(column)-1)
  301.   GOSUB whichcard
  302.   IF out(suit)<>value-1 THEN
  303.     IF out(suit)<>0 THEN tempvalue=out(suit)
  304.     RETURN
  305.   END IF
  306.   erasecard column,up(column)+down(column),up(column)+down(column)-1
  307.   playcard 79,47*suit-38
  308.   out(suit)=value
  309.   fdation=-1
  310.   money=money+5:GOSUB prtmoney
  311.   up(column)=up(column)-1
  312.   IF column=0 THEN
  313.     talon(up(0))=0
  314.     IF up(0)>0 THEN
  315.       num=talon(up(0)-1)
  316.       GOSUB whichcard
  317.       playcard 10,4*(up(0))+5
  318.     END IF
  319.     RETURN
  320.   END IF
  321.   showing(column,up(column))=0
  322.   IF up(column)=0 THEN
  323.     IF hidden(column,0)>0 THEN GOSUB putback
  324.     showing(column,0)=hidden(column,0)
  325.     IF hidden(column,0)=0 THEN RETURN
  326.     num=showing(column,0)
  327.     GOSUB whichcard
  328.     playcard 69*column+10,8*down(column)+1
  329.     FOR i=0 TO 4
  330.       hidden(column,i)=hidden(column,i+1)
  331.     NEXT
  332.     hidden(column,5)=0
  333.     up(column)=1
  334.     down(column)=down(column)-1:IF down(column)<0 THEN down(column)=0
  335.   ELSE
  336.     num=showing(column,up(column)-1)
  337.     GOSUB whichcard
  338.     playcard 69*column+10,8*(up(column)+down(column))+1
  339.   END IF
  340.   RETURN
  341.  
  342. prtmoney:
  343.   drawmode& 1
  344.   COLOR 3+(money>0),1
  345.   printat& 17,139,SADD("$"+nl$)
  346.   PRINT USING "#####";money
  347.   COLOR ,0
  348.   drawmode& 0
  349.   RETURN
  350.  
  351. dealcard:
  352.   drawmode& 2
  353.   ystep=139-yy
  354.   xstep=xx/10
  355.   ystep=INT(ystep/xstep)+2
  356.   y=139
  357.   FOR x=5 TO xx STEP 20
  358.     y=y-ystep
  359.     LINE (x,y)-STEP(59,43),4,b
  360.     LINE (x,y)-STEP(59,43),4,b
  361.   NEXT
  362.   drawmode& 0
  363.   RETURN
  364.  
  365. fastmenu:
  366.   fx=150:fy=126
  367.   GET (fx,fy)-(fx+115,fy+69),fback
  368.   LINE (fx,fy)-STEP(115,69),1,bf
  369.   LINE (fx+2,fy+1)-STEP(111,67),0,bf
  370.   LINE (fx+4,fy+2)-STEP(107,65),1,bf
  371.   sbox& fx+6,fy+3,7, SADD("   RETURN   "+nl$)
  372.   sbox& fx+6,fy+16,7,SADD("  NEW GAME  "+nl$)
  373.   sbox& fx+6,fy+29,7,SADD(" CARD STUFF "+nl$)
  374.   sbox& fx+6,fy+42,7,SADD("INSTRUCTIONS"+nl$)
  375.   sbox& fx+6,fy+55,7,SADD("    QUIT    "+nl$)
  376. floop:
  377.   CALL whoa:x=MOUSE(3):y=MOUSE(4)
  378.   IF x<fx+6 OR x>fx+108 OR y<fy+3 OR y>y+68 THEN floop
  379.   fm=INT((y-fy-3)/13)
  380.   PUT (fx,fy),fback,PSET
  381.   ON fm GOTO start,design,help,quit
  382.   GOTO checkmouse
  383. design:
  384.   CLS:ding
  385.   temp&=PEEKL(PEEKL(PEEKL(WINDOW(7)+46)+48)+4)
  386.   copy& temp&,VARPTR(rgb(0,1)),32
  387.   skipflag=0
  388.   LINE (2,4)-STEP(251,187),1,bf
  389.   LINE (4,5)-STEP(247,185),0,bf
  390.   LINE (262,60)-STEP(139,129),1,bf
  391.   LINE (264,61)-STEP(135,127),0,bf
  392.   LINE (266,62)-STEP(131,125),1,bf
  393.   COLOR 2:drawmode& 0:printat& 272,63,SADD("ClickClickClick"+nl$):COLOR 1
  394.   RESTORE design
  395.   FOR i=0 TO 8:READ msg$:sbox& 268,13*i+71,7,SADD(msg$+nl$):NEXT
  396.   DATA "RETURN  To Game","SAVE  This Deck","LOAD A New Deck"
  397.   DATA "LOAD Amiga Deck","D. Addison Deck","UNDO My Changes"
  398.   DATA " Palette  UNDO "," Palette RESET "," QUIT  Program "
  399.   LINE (410,60)-STEP(218,129),1,bf
  400.   LINE (412,61)-STEP(214,127),0,bf
  401.   FOR i=0 TO 2
  402.     LINE (71*i+415,62)-STEP(66,79),1,bf
  403.     LINE (71*i+417,63)-STEP(62,77),0,bf
  404.   NEXT
  405.   FOR i=0 TO 7:LINE (26*i+416,153)-STEP(23,32),i,bf:NEXT
  406.   LINE (26*colr+415,151)-STEP(25,36),1,b
  407.   GOSUB designer
  408. drawloop:
  409.   whoa
  410.   x=MOUSE(3):y=MOUSE(4):GOSUB checkbutton:IF skipflag THEN start
  411.   IF x>416 AND x<624 AND y>63 AND y<140 THEN
  412.     x=INT((x-416)/71)
  413.     WHILE MOUSE(0)<0
  414.       colr(x)=15-(INT((MOUSE(2)-63)/5) AND 15)
  415.       PALETTE colr,colr(0)/16,colr(1)/16,colr(2)/16:GOSUB showit
  416.     WEND
  417.   ELSEIF x>416 AND x<624 AND y>153 AND y<188 THEN
  418.     WHILE MOUSE(0)<0
  419.       LINE (26*colr+415,151)-STEP(25,36),0,b
  420.       colr=INT((MOUSE(1)-416)/26) AND 7
  421.       LINE (26*colr+415,151)-STEP(25,36),1,b
  422.     WEND:GOSUB getrgb
  423.   ELSEIF x>6 AND x<252 AND y>6 AND y<190 THEN
  424.     WHILE MOUSE(0)<0
  425.       x=INT((MOUSE(1)-6)/4)
  426.       IF x<0 THEN x=0
  427.       IF x>60 THEN x=60
  428.       y=INT((MOUSE(2)-6)/4)
  429.       IF y<0 THEN y=0
  430.       IF y>45 THEN y=45
  431.       LINE (4*x+6,4*y+6)-STEP(3,3),colr,bf
  432.       PSET (75*card+x+264,y+8),colr
  433.     WEND
  434.   ELSEIF x>260 AND x<624 AND y>6 AND y<55 THEN
  435.     card=INT((x-260)/75):GOSUB newcard
  436.   END IF
  437.   GOTO drawloop
  438. checkbutton:
  439.   IF x>268 AND x<396 AND y>71 AND y<188 THEN
  440.     y=INT((y-71)/13):ding
  441.     ON y+1 GOTO keep,savem,loadem,amideck,dadeck,undoall,undocolr,resetcolr,quit
  442.   END IF
  443.   RETURN
  444. keep:skipflag=-1:RETURN
  445. savem:
  446.   GOSUB newscreen
  447.   greet$="SAVE under what name?"+nl$:file$=STRING$(360,0)
  448.   request& 0,30,SADD(greet$),SADD(file$),1
  449.   GOSUB byescreen
  450.   file$=LEFT$(file$,INSTR(file$,nl$)-1)
  451.   IF file$="" OR file$="AMIGA" OR file$="ADDISON" THEN RETURN
  452.   FOR i=0 TO 4:GET (75*i+264,8)-(75*i+264+61,9+45),card(0,i):NEXT
  453.   copy& temp&,VARPTR(rgb(0,0)),32
  454.   bopenw& SADD(file$+nl$)
  455.     bwrite& VARPTR(rgb(0,0)),64
  456.     bwrite& VARPTR(card(0,0)),5660
  457.   bclose&
  458.   RETURN
  459. loadem:
  460.   GOSUB newscreen
  461.   greet$="Please tell me what to LOAD..."+nl$:file$=STRING$(360,0)
  462.   request& 0,30,SADD(greet$),SADD(file$),0
  463.   GOSUB byescreen
  464.   file$=LEFT$(file$,INSTR(file$,nl$))
  465.   IF LEFT$(file$,1)=nl$ THEN RETURN
  466.   bopenr& SADD(file$)
  467.     bread& VARPTR(rgb(0,0)),64
  468.     bread& VARPTR(card(0,0)),5660
  469.   bclose&
  470.   loadRGB& VARPTR(rgb(0,0)),32
  471.   GOTO designer
  472. amideck:
  473.   bopenr& SADD("AMIGA"+nl$)
  474.     bread& VARPTR(rgb(0,0)),64
  475.     bread& VARPTR(card(0,0)),5660
  476.   bclose&
  477.   loadRGB& VARPTR(rgb(0,0)),32
  478.   IF NOT skipflag THEN designer
  479.   RETURN
  480. dadeck:
  481.   bopenr& SADD("ADDISON"+nl$)
  482.     bread& VARPTR(rgb(0,0)),64
  483.     bread& VARPTR(card(0,0)),5660
  484.   bclose&
  485.   loadRGB& VARPTR(rgb(0,0)),32
  486.   GOTO designer
  487. undoall:loadRGB& VARPTR(rgb(0,0)),32:GOSUB designer:RETURN
  488. undocolr:loadRGB& VARPTR(rgb(0,1)),32:GOSUB getrgb:RETURN
  489. resetcolr:loadRGB& VARPTR(rgb(0,0)),32:GOSUB getrgb:RETURN
  490. designer:
  491.   FOR card=0 TO 4
  492.     LINE (75*card+260,6)-STEP(68,49),1,bf
  493.     LINE (75*card+262,7)-STEP(64,47),0,bf
  494.     PUT(75*card+264,8),card(0,card),PSET
  495.   NEXT:card=0
  496.   GOSUB getrgb
  497. newcard:
  498.   blowup& WINDOW(7),75*card+264,8,6,6
  499.   COLOR 1:drawmode& 1
  500.   RETURN
  501. getrgb:
  502.   msg$=RIGHT$("00"+HEX$(PEEKW(temp&+2*colr)),3)
  503.   FOR x=0 TO 2:colr(x)=VAL("&h"+MID$(msg$,x+1,1)):GOSUB showit:NEXT
  504.   RETURN
  505. showit:
  506.   LINE (71*x+419,139)-STEP(58,-5*colr(x)),colr-(colr=0),bf
  507.   LINE -(71*x+419,64),0,bf
  508.   printat& 71*x+445,143,SADD(HEX$(colr(x))+nl$)
  509.   RETURN
  510. help:
  511.   GOSUB newscreen
  512.   RESTORE help
  513.   scolr& 1,2
  514.   FOR i=1 TO 10:READ y,msg$:shadow& -1,y,SADD(msg$+nl$):NEXT
  515.   DATA 20,"Click directly on card",30,"to put on Foundation"
  516.   DATA 50,"Click above or below card",60,"to pick it up"
  517.   DATA 80,"If card can't be played on Foundation",90,"the cards will be picked up"
  518.   DATA 110,"Click on back of card",120,"in lower left corner of screen"
  519.   DATA 130,"to draw from deck",150,"Click Mouse"
  520.   scolr& 1,3
  521.   whoa
  522.   GOSUB byescreen
  523.   GOTO checkmouse
  524. newscreen:
  525.   SCREEN 2,320,200,2,1:WINDOW 3," ",,0,2
  526.   w7& WINDOW(7):POKE WINDOW(7)+99,0:refresh&
  527.   loadRGB& VARPTR(rgb(0,0)),32
  528.   RETURN
  529. byescreen:WINDOW CLOSE 3:SCREEN CLOSE 2:w7& WINDOW(7):RETURN
  530. slowquit:ding:whoa
  531. quit:
  532.   ding
  533.   WINDOW CLOSE 2
  534.   SCREEN CLOSE 1
  535.   WINDOW 1
  536.   MENU RESET
  537.   CHDIR "/"
  538.   IF blowup&>0 THEN CALL freemem&(blowup&)
  539.   IF bye&>0 THEN CALL bye&
  540.   CLEAR,25000
  541.   SYSTEM
  542.   END
  543.  
  544. SUB whoa STATIC
  545.   WHILE MOUSE(0)<>0:WEND
  546.   WHILE MOUSE(0)=0:SLEEP:WEND
  547. END SUB
  548.  
  549. SUB pause(delay!) STATIC
  550.   delay!=delay!+TIMER
  551.   WHILE TIMER<delay!:WEND
  552. END SUB
  553.  
  554. SUB ding STATIC
  555.   SOUND 400,1,255,0
  556.   SOUND 500,1,255,1
  557.   SOUND 600,1,255,2
  558.   SOUND 800,1,255,3
  559. END SUB
  560.  
  561. SUB oops(which) STATIC
  562.   SHARED tx$(),value,tempvalue,shadow&,nl$
  563.   ON which GOSUB e1,e2,e3,e4,e5,e6,e7,e8,e9
  564.   shadow& 315-4*LEN(a$),0,SADD(a$+nl$)
  565.   FOR which=1 TO 4:SOUND 2000,2,255,2:SOUND 4000,1,255,3:pause .4:NEXT
  566.   LINE (0,0)-(630,9),0,bf
  567. EXIT SUB
  568. e1: a$="YOU'VE ALREADY PICKED UP A CARD":RETURN
  569. e2: a$="THERE ARE NO MORE CARDS IN THE DECK!":RETURN
  570. e3: a$="YOU DO NOT HAVE ANY CARDS TO PLAY":RETURN
  571. e4: a$="YOU CAN'T PLAY BLACK ON BLACK":RETURN
  572. e5: a$="YOU CAN'T PLAY RED ON RED":RETURN
  573. e6: a$="YOU CAN'T PLAY A"+tx$(value)+" ON A"+tx$(tempvalue):RETURN
  574. e7: a$="YOU CAN'T PLAY CARDS HERE":RETURN
  575. e8: a$="YOU CAN ONLY PLAY A KING HERE":RETURN
  576. e9: a$="THERE ARE NO CARDS HERE TO PICK UP":RETURN
  577. END SUB
  578.  
  579. SUB playcard(x,y) STATIC
  580.   SHARED card(),suit,value,c$,printat&,nl$
  581.   SOUND 100,.35,255,2
  582.   SOUND 70,.25,255,3
  583.   PUT (x,y),card(0,suit),PSET
  584.   COLOR 2-(suit>2)
  585.   printat& x+2,y+2,SADD(MID$(c$,value,1)+nl$)
  586.   printat& x+51,y+38,SADD(MID$(c$,value,1)+nl$)
  587. END SUB
  588.  
  589. SUB erasecard(column,start,finish) STATIC
  590.   IF column=0 THEN
  591.     FOR i=4*start+47 TO 4*start+3 STEP -4
  592.       LINE (10,i)-STEP(61,3),0,bf
  593.     NEXT
  594.   ELSE
  595.     FOR i=8*start+43 TO 8*finish+7 STEP -4
  596.       LINE (69*column+10,i)-STEP(61,3),0,bf
  597.     NEXT
  598.   END IF
  599. END SUB
  600.